Authors - MSWord file split

[sasha17]

***copied & pasted directly from the forum***

Here's a macro I found online that actually does what it's supposed to do. It splits a large Word document into separate files, so if you're posting a story (for example) to a forum that has character limits, you can split a document into smaller Word files without losing anything.*

Here's the macro code:

'-------------Begin-----------------
Sub doc_splitter()
' Copyright by W. Polmann
' Use at your own risk

origdoc = ActiveDocument.Name

Dim Mldg, Titel, Voreinstellung, Batches
Mldg = "Number of batches?"
Titel = "Freeware by www.ecm-e.de, W. Polmann."
Voreinstellung = "1" ' Voreinstellung festlegen.
' Meldung, Titel und Standardwert anzeigen.
Batches = InputBox(Mldg, Titel, Voreinstellung)

Prozentsprung = 100 / Batches

For x = 1 To Batches


ActiveDocument.SaveAs FileName:="Teil_" & x & "_" & origdoc & ".doc", _
FileFormat:=wdFormatDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False


EndeProzentsprung = Prozentsprung * x
AnfangProzentsprung = EndeProzentsprung - Prozentsprung


Selection.GoTo What:=wdGoToPercent, Which:=wdGoToNext, Count:=AnfangProzentsprung, Name:=""
Anfang = Selection.Start

Selection.GoTo What:=wdGoToPercent, Which:=wdGoToNext, Count:=EndeProzentsprung, Name:=""
' Bis zur n?chsten Absatzmarke hoch


Selection.Find.ClearFormatting
With Selection.Find
.text = "^p"
.Replacement.text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=1
Ende = Selection.End


Set Range = ActiveDocument.Range(Anfang, Ende)


Range.Select
Selection.Copy


Selection.WholeStory
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Paste
ActiveDocument.Save
ActiveDocument.Close

Documents.Open FileName:=origdoc, _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
wdOpenFormatAuto

Next x

ActiveDocument.Close

End Sub
'---------End---------------

Notes:

• [li]To add a macro to Word 2007, u MUST have the 'Developer' tab showing in the ribbon. Add that thru the Word Options panel.[/li]
  [li]In Word 2007, I had to delete the '--------End------ comment.[/li]
  [li]The macro will ask u how many parts to make.[/li]
  [li]The macro will rename your files, adding a 'Teil_x_originalfilename.docx.doc' format, but ur original document will remain intact.[/li]
  [li]Use a BackUp copy![/li]
  [li]Just open the file, and run the macro.[/li]

* I didn't 'lose' anything, but some of u aren't me.

[Catwacher]

Thanks sweetheart! :-)